home *** CD-ROM | disk | FTP | other *** search
/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Source / MacTech® Magazine / Volume 02 - 1986 / 02.08 Aug 86.sit / 02.08 Aug 86 / basic / SAMPLE PROGRAMS / TRUE BASIC / TB DEMO next >
Encoding:
Text File  |  1986-07-05  |  4.6 KB  |  137 lines  |  [TEXT/TRUE]
  1. ! Menu/Window Demo
  2. ! True Basic version
  3. ! by Dave Kelly
  4. ! ©1986 MacTutor
  5.  
  6. LIBRARY ":Toolbox Libraries:menulib*"
  7. LIBRARY ":Toolbox Libraries:windowlib*"
  8. LIBRARY ":Toolbox Libraries:desklib*"
  9. LIBRARY ":Toolbox Libraries:eventlib*"
  10. LIBRARY ":Toolbox Libraries:quicklib*"
  11. LIBRARY ":Toolbox Libraries:datalib*"
  12. LIBRARY ":Toolbox Libraries:maclib*"
  13. LIBRARY ":Toolbox Libraries:addr*"
  14. LIBRARY ":Toolbox Libraries:pass_mac*"
  15. LIBRARY ":Toolbox Libraries:s_trap*"
  16. LIBRARY ":Toolbox Libraries:r_trap*"
  17. LIBRARY ":Toolbox Libraries:tostring*"
  18.  
  19. DECLARE DEF NIL$,POINTER$,screenBits$,bounds$
  20. DECLARE DEF OpenDeskAcc,NewWindow$,SystemEdit
  21. DECLARE DEF MenuSelect
  22.  
  23. DIM MyMenus$(1:4)                 ! We have four menus
  24.  
  25. CALL TakeMac                      ! Take control of the Mac
  26. CALL SetUpMenus                   ! Set up menus
  27. LET everyevent = -1
  28. LET doneFlag = 0                  ! initialize DO-UNTIL loop
  29. LET R$ = bounds$(screenBits$)     ! Get screen rectangle
  30. CALL SetRect(R$,100,100,400,225)  ! Set window rectangle
  31. LET myWindow$ = NewWindow$(NIL$,R$,"",-1,1,POINTER$(-1),0,0)
  32. CALL SetPort(myWindow$)
  33. CALL Drawwindow
  34.  
  35. ! Main Event Loop
  36.  
  37. DO
  38.    CALL SystemTask
  39.    CALL GetNextEvent(everyevent,theEvent$,eResult)    ! Get Event
  40.    IF eResult <> 0 then
  41.       CALL UnpackEvent(theEvent$,what,mess,when,where$,mod)
  42.       SELECT CASE what            ! Branch on event type
  43.       CASE 1                      ! Mouse down event
  44.            CALL FindWindow(where$,whichWindow$,wResult)    ! Find out where
  45.            SELECT CASE wResult    ! Branch on location
  46.            CASE 1                 ! In menu bar
  47.                 LET mResult = MenuSelect(where$)
  48.                 CALL DoMenu(mResult)   ! Act on menu
  49.            CASE 2                 ! In System window
  50.                 CALL SystemClick(theEvent$,whichWindow$)   ! Pass events to desk accessory
  51.            CASE else
  52.            END SELECT             ! for mouse-down location
  53.       CASE 6                      ! Update event
  54.            CALL Packb(w$,1,32,mess)    ! Extract window pointer
  55.            CALL BeginUpdate(w$)   ! Begin update
  56.            CALL Drawwindow        ! Update window
  57.            CALL EndUpdate(w$)     ! End update
  58.       CASE else
  59.       END SELECT
  60.    END IF
  61. LOOP UNTIL doneFlag <> 0
  62.  
  63. CALL DisposeWindow(myWindow$)
  64. CALL ClearMenuBar
  65. FOR i = Lbound(MyMenus$) TO Ubound(MyMenus$)
  66.     CALL DisposeMenu(MyMenus$(i))
  67. NEXT i
  68.  
  69. CALL GiveMac                      ! Return control to True Basic
  70. STOP                              ! all done!!
  71.  
  72. SUB Drawwindow
  73.     CALL TEXTFONT(2)
  74.     CALL TEXTSIZE(12)
  75.     CALL TEXTFACE(1)
  76.     CALL TEXTMODE(0)
  77.     CALL MOVETO(10,20)
  78.     CALL DRAWSTRING("MacTutor shows you how it works!")
  79.     CALL TEXTFACE(0)
  80.     CALL MOVETO(10,100)
  81.     CALL DRAWSTRING("True BASIC Version 1.1 demo")
  82. END SUB
  83.  
  84. SUB DoMenu(code)
  85.     CALL Packb(s$,1,32,code)      ! Replace with HiWort and LoWord
  86.     LET MenuNumber = Unpackb(s$,1,-16)
  87.     LET MenuItem = Unpackb(s$,17,-16)
  88.  
  89.     SELECT CASE MenuNumber
  90.     CASE 1                        ! Apple Menu
  91.          CALL GetItem(MyMenus$(1),MenuItem,name$)     ! Get Menu item name
  92.          LET mrefNum = OpenDeskAcc(name$)   ! Open desk accessory
  93.          CALL SetPort(mywindow$)  ! Restore current grafport
  94.     CASE 2                        ! File Menu
  95.          LET doneFlag = -1        ! Set flag to quit
  96.     CASE 3                        ! Edit Menu
  97.          LET z = SystemEdit(Menuitem+1)
  98.     CASE 4                        ! Sample Menu
  99.          CALL MOVETO(10,50)
  100.          LET textstring$ = "You have selected menu item " & STR$(menuitem)
  101.          CALL DRAWSTRING(textstring$)
  102.     CASE else                     ! No Selection
  103.     END SELECT
  104.     CALL HiliteMenu(0)            ! unhighlight menu
  105. END SUB
  106.  
  107. SUB SetUpMenus
  108.  
  109.     DECLARE DEF NewMenu$
  110.  
  111.     LET MyMenus$(1) = NewMenu$(1,chr$(20))  ! Get apple menu
  112.     CALL AddResMenu(MyMenus$(1),"DRVR")     ! Fill it in
  113.  
  114.     LET MyMenus$(2) = NewMenu$(2,"File")    ! Get file menu
  115.     CALL AppendMenu(MyMenus$(2),"Quit")     ! Quit command
  116.  
  117.     LET MyMenus$(3) = NewMenu$(3,"Edit")    ! Get edit menu
  118.     CALL AppendMenu(MyMenus$(3),"Cut")      ! Cut command
  119.     CALL AppendMenu(MyMenus$(3),"Copy")     ! Copy command
  120.     CALL AppendMenu(MyMenus$(3),"Paste")    ! Paste command
  121.  
  122.     LET MyMenus$(4) = NewMenu$(4,"Sample Menu")  ! Get sample menu
  123.     CALL AppendMenu(MyMenus$(4),"Item 1")   ! Menu item 1
  124.     CALL AppendMenu(MyMenus$(4),"Item 2")   ! Menu item 2
  125.     CALL AppendMenu(MyMenus$(4),"Item 3")   ! Menu item 3
  126.  
  127.  
  128.     FOR i = Lbound(MyMenus$) to Ubound(MyMenus$)
  129.         CALL InsertMenu(MyMenus$(i),0)      ! Insert each menu
  130.     NEXT i
  131.  
  132.     CALL DrawMenuBar              ! Draw in the menu bar
  133.  
  134. END SUB
  135.  
  136. END
  137.